Attribute VB_Name = "modWheelScrollBar"
Private Declare Function CallWindowProc Lib "USER32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SetWindowLong Lib "USER32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Private Const GWL_WNDPROC = -4
Private Const SPI_GETWHEELSCROLLLINES = 104
Private Const WM_MOUSEWHEEL = &H20A
Private WHEEL_SCROLL_LINES As Long
Private lProc As Long

Private vsc As VScrollBar

Public Sub Hook(ByVal hWnd As Long, vs As VScrollBar)
    Set vsc = vs
    lProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Public Sub UnHook(ByVal hWnd As Long)
    Dim r As Long
    r = SetWindowLong(hWnd, GWL_WNDPROC, lProc)
    Set vsc = Nothing
End Sub

Private Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If uMsg = WM_MOUSEWHEEL Then
        Dim MW_FB As Integer
        MW_FB = (wParam And &HFFFF0000) \ &H10000

        Dim k As Integer
        
        k = (vsc.value - Sgn(MW_FB) * vsc.LargeChange)
        If k > vsc.Max Then
            k = vsc.Max
        End If
        
        If k < vsc.Min Then
            k = vsc.Min
        End If
        vsc.value = k
    End If
    
    WindowProc = CallWindowProc(lProc, hw, uMsg, wParam, lParam)
End Function
